home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch6 / SubEdge2.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-04-25  |  7.2 KB  |  220 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Begin VB.Form frmSubEdge2 
  4.    Caption         =   "SubEdge2 []"
  5.    ClientHeight    =   2910
  6.    ClientLeft      =   165
  7.    ClientTop       =   735
  8.    ClientWidth     =   5175
  9.    LinkTopic       =   "Form2"
  10.    ScaleHeight     =   2910
  11.    ScaleWidth      =   5175
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin MSComDlg.CommonDialog dlgOpenFile 
  14.       Left            =   0
  15.       Top             =   840
  16.       _ExtentX        =   847
  17.       _ExtentY        =   847
  18.       _Version        =   393216
  19.    End
  20.    Begin VB.PictureBox picOriginal 
  21.       AutoSize        =   -1  'True
  22.       Height          =   2775
  23.       Left            =   120
  24.       ScaleHeight     =   181
  25.       ScaleMode       =   3  'Pixel
  26.       ScaleWidth      =   157
  27.       TabIndex        =   1
  28.       Top             =   0
  29.       Width           =   2415
  30.    End
  31.    Begin VB.PictureBox picResult 
  32.       Height          =   2775
  33.       Left            =   2640
  34.       ScaleHeight     =   181
  35.       ScaleMode       =   3  'Pixel
  36.       ScaleWidth      =   157
  37.       TabIndex        =   0
  38.       Top             =   0
  39.       Width           =   2415
  40.    End
  41.    Begin VB.Menu mnuFile 
  42.       Caption         =   "&File"
  43.       Begin VB.Menu mnuFileOpen 
  44.          Caption         =   "&Open..."
  45.          Shortcut        =   ^O
  46.       End
  47.       Begin VB.Menu mnuFileSaveAs 
  48.          Caption         =   "Save &As..."
  49.          Shortcut        =   ^A
  50.       End
  51.    End
  52. Attribute VB_Name = "frmSubEdge2"
  53. Attribute VB_GlobalNameSpace = False
  54. Attribute VB_Creatable = False
  55. Attribute VB_PredeclaredId = True
  56. Attribute VB_Exposed = False
  57. Option Explicit
  58. ' Arrange the controls.
  59. Private Sub ArrangeControls()
  60.     ' Position the result PictureBox.
  61.     picResult.Move _
  62.         picOriginal.Left + picOriginal.Width + 120, _
  63.         picOriginal.Top, _
  64.         picOriginal.Width, _
  65.         picOriginal.Height
  66.     picResult.Cls
  67.     ' This makes the image resize itself to
  68.     ' fit the picture.
  69.     picResult.Picture = picResult.Image
  70.     ' Make the form big enough.
  71.     Width = picResult.Left + picResult.Width + _
  72.         Width - ScaleWidth + 120
  73.     Height = picResult.Top + picResult.Height + _
  74.         Height - ScaleHeight + 120
  75.     DoEvents
  76. End Sub
  77. ' Transform the image.
  78. Private Sub TransformImage()
  79. Dim pixels() As RGBTriplet
  80. Dim new_pixels() As RGBTriplet
  81. Dim bits_per_pixel As Integer
  82. Dim brightness As Integer
  83. Dim r As Integer
  84. Dim g As Integer
  85. Dim b As Integer
  86. Dim X As Integer
  87. Dim Y As Integer
  88. Dim i As Integer
  89. Dim j As Integer
  90.     ' Get the pixels from picOriginal.
  91.     GetBitmapPixels picOriginal, pixels, bits_per_pixel
  92.     ' Allocate the new_pixels array.
  93.     ReDim new_pixels( _
  94.         LBound(pixels, 1) To UBound(pixels, 1), _
  95.         LBound(pixels, 2) To UBound(pixels, 2))
  96.     ' Set the pixel color values.
  97.     For Y = 1 To picOriginal.ScaleHeight - 2
  98.         For X = 1 To picOriginal.ScaleWidth - 2
  99.             With pixels(X, Y)
  100.                 r = 0
  101.                 g = 0
  102.                 b = 0
  103.                 For i = -1 To 1
  104.                     For j = -1 To 1
  105.                         r = r + Abs(CInt(.rgbRed) - pixels(X + i, Y + j).rgbRed)
  106.                         g = g + Abs(CInt(.rgbGreen) - pixels(X + i, Y + j).rgbGreen)
  107.                         b = b + Abs(CInt(.rgbBlue) - pixels(X + i, Y + j).rgbBlue)
  108.                     Next j
  109.                 Next i
  110.                 If r < 0 Then r = 0
  111.                 If r > 255 Then r = 255
  112.                 If g < 0 Then g = 0
  113.                 If g > 255 Then g = 255
  114.                 If b < 0 Then b = 0
  115.                 If b > 255 Then b = 255
  116.                 new_pixels(X, Y).rgbRed = r
  117.                 new_pixels(X, Y).rgbGreen = g
  118.                 new_pixels(X, Y).rgbBlue = b
  119.             End With
  120.         Next X
  121.     Next Y
  122.     ' Set picResult's pixels.
  123.     SetBitmapPixels picResult, bits_per_pixel, new_pixels
  124.     picResult.Picture = picResult.Image
  125. End Sub
  126. ' Start in the current directory.
  127. Private Sub Form_Load()
  128.     picOriginal.AutoSize = True
  129.     picOriginal.ScaleMode = vbPixels
  130.     picOriginal.AutoRedraw = True
  131.     picResult.ScaleMode = vbPixels
  132.     picResult.AutoRedraw = True
  133.     dlgOpenFile.CancelError = True
  134.     dlgOpenFile.InitDir = App.Path
  135.     dlgOpenFile.Filter = _
  136.         "Bitmaps (*.bmp)|*.bmp|" & _
  137.         "GIFs (*.gif)|*.gif|" & _
  138.         "JPEGs (*.jpg)|*.jpg;*.jpeg|" & _
  139.         "Icons (*.ico)|*.ico|" & _
  140.         "Cursors (*.cur)|*.cur|" & _
  141.         "Run-Length Encoded (*.rle)|*.rle|" & _
  142.         "Metafiles (*.wmf)|*.wmf|" & _
  143.         "Enhanced Metafiles (*.emf)|*.emf|" & _
  144.         "Graphic Files|*.bmp;*.gif;*.jpg;*.jpeg;*.ico;*.cur;*.rle;*.wmf;*.emf|" & _
  145.         "All Files (*.*)|*.*"
  146. End Sub
  147. ' Load the indicated file.
  148. Private Sub mnuFileOpen_Click()
  149. Dim file_name As String
  150.     ' Let the user select a file.
  151.     On Error Resume Next
  152.     dlgOpenFile.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
  153.     dlgOpenFile.ShowOpen
  154.     If Err.Number = cdlCancel Then
  155.         Exit Sub
  156.     ElseIf Err.Number <> 0 Then
  157.         Beep
  158.         MsgBox "Error selecting file.", , vbExclamation
  159.         Exit Sub
  160.     End If
  161.     On Error GoTo 0
  162.     Screen.MousePointer = vbHourglass
  163.     DoEvents
  164.     file_name = Trim$(dlgOpenFile.FileName)
  165.     dlgOpenFile.InitDir = Left$(file_name, Len(file_name) _
  166.         - Len(dlgOpenFile.FileTitle) - 1)
  167.     Caption = "SubEdge2 [" & dlgOpenFile.FileTitle & "]"
  168.     ' Open the original file.
  169.     On Error GoTo LoadError
  170.     picOriginal.Picture = LoadPicture(file_name)
  171.     On Error GoTo 0
  172.     ' Make picResult the same size and position it.
  173.     ArrangeControls
  174.     ' Make picResult show the same image.
  175.     picResult.Picture = picOriginal.Picture
  176.     DoEvents
  177.     ' Perform the enhancement.
  178.     TransformImage
  179.     Screen.MousePointer = vbDefault
  180.     Exit Sub
  181. LoadError:
  182.     Screen.MousePointer = vbDefault
  183.     MsgBox "Error " & Format$(Err.Number) & _
  184.         " opening file '" & file_name & "'" & vbCrLf & _
  185.         Err.Description
  186. End Sub
  187. ' Save the transformed image.
  188. Private Sub mnuFileSaveAs_Click()
  189. Dim file_name As String
  190.     ' Let the user select a file.
  191.     On Error Resume Next
  192.     dlgOpenFile.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly
  193.     dlgOpenFile.ShowSave
  194.     If Err.Number = cdlCancel Then
  195.         Exit Sub
  196.     ElseIf Err.Number <> 0 Then
  197.         Beep
  198.         MsgBox "Error selecting file.", , vbExclamation
  199.         Exit Sub
  200.     End If
  201.     On Error GoTo 0
  202.     Screen.MousePointer = vbHourglass
  203.     DoEvents
  204.     file_name = Trim$(dlgOpenFile.FileName)
  205.     dlgOpenFile.InitDir = Left$(file_name, Len(file_name) _
  206.         - Len(dlgOpenFile.FileTitle) - 1)
  207.     Caption = "SubEdge2 [" & dlgOpenFile.FileTitle & "]"
  208.     ' Save the transformed image into the file.
  209.     On Error GoTo SaveError
  210.     SavePicture picResult.Picture, file_name
  211.     On Error GoTo 0
  212.     Screen.MousePointer = vbDefault
  213.     Exit Sub
  214. SaveError:
  215.     Screen.MousePointer = vbDefault
  216.     MsgBox "Error " & Format$(Err.Number) & _
  217.         " saving file '" & file_name & "'" & vbCrLf & _
  218.         Err.Description
  219. End Sub
  220.